home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / pbase.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  8KB  |  243 lines
  1. {
  2.     $Id: pbase.pas,v 1.1.1.1 1998/03/25 11:18:14 root Exp $
  3.     Copyright (c) 1998 by Florian Klaempfl
  4.  
  5.     Contains some helper routines for the parser
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. unit pbase;
  24.  
  25.   interface
  26.  
  27.     uses
  28.        cobjects,globals,scanner,symtable,systems,verbose;
  29.  
  30.     const
  31.        { forward types should only be possible inside  }
  32.        { a TYPE statement, this crashed the compiler   }
  33.        { when trying to dispose local symbols          }
  34.        typecanbeforward : boolean = false;
  35.  
  36.        { true, if we are after an assignement }
  37.        afterassignment : boolean = false;
  38.        { sspecial for handling procedure vars }
  39.        getprocvar : boolean = false;
  40.        getprocvardef : pprocvardef = nil;
  41.  
  42.     var
  43.        { contains the current token to be processes }
  44.        token : ttoken;
  45.  
  46.        { size of data segment, set by proc_unit or proc_program }
  47.        datasize : longint;
  48.  
  49.        { for operators }
  50.        optoken : ttoken;
  51.        opsym : pvarsym;
  52.  
  53.        { symtable were unit references are stored }
  54.        refsymtable : psymtable;
  55.  
  56.        { true, if only routine headers should be }
  57.        { parsed                    }
  58.        parse_only : boolean;
  59.  
  60.        { true, if we are in a except block }
  61.        in_except_block : boolean;
  62.  
  63.     { consumes token i, if the current token is unequal i }
  64.     { a syntax error is written                           }
  65.     procedure consume(i : ttoken);
  66.  
  67.     { consumes all tokens til atoken (for error recovering }
  68.     procedure consume_all_until(atoken : ttoken);
  69.  
  70.     { consumes tokens while they are semicolons }
  71.     procedure emptystats;
  72.  
  73.     { reads a list of identifiers into a string container }
  74.     function idlist : pstringcontainer;
  75.  
  76.     { inserts the symbols of sc in st with def as definition }
  77.     { sc is disposed                                         }
  78.     procedure insert_syms(st : psymtable;sc : pstringcontainer;def : pdef);
  79.  
  80.  
  81.   implementation
  82.  
  83.  
  84.     { consumes token i, if the current token is unequal i }
  85.     { a syntax error is written                           }
  86.     procedure consume(i : ttoken);
  87.  
  88.       { generates a syntax error message }
  89.       procedure syntaxerror(const s : string);
  90.  
  91.         begin
  92.            Message2(scan_f_syn_expected,tostr(get_current_col),s);
  93.         end;
  94.  
  95.       { This is changed since I changed the order of token
  96.       in cobjects.pas for operator overloading !!!! }
  97.       { ttoken = (PLUS,MINUS,STAR,SLASH,EQUAL,GT,LT,LTE,GTE,SYMDIF,CARET,ASSIGNMENT,
  98.                  LECKKLAMMER,RECKKLAMMER,
  99.                  POINT,COMMA,LKLAMMER,RKLAMMER,COLON,SEMICOLON,
  100.                  KLAMMERAFFE,UNEQUAL,POINTPOINT,
  101.                  ID,REALNUMBER,_EOF,INTCONST,CSTRING,CCHAR,DOUBLEADDR,}
  102.  
  103.  
  104.       const tokens : array[PLUS..DOUBLEADDR] of string[12] = (
  105.                  '+','-','*','/','=','>','<','>=','<=','is','as','in',
  106.                  '><','^',':=','<>','[',']','.',',','(',')',':',';',
  107.                  '@','..',
  108.                  'identifier','const real.','end of file',
  109.                  'ord const','const string','const char','@@');
  110.  
  111.       var
  112.          j : integer;
  113.  
  114.       begin
  115.          if token<>i then
  116.            begin
  117.               if i<_AND then
  118.                 syntaxerror(tokens[i])
  119.               else
  120.                 begin
  121.  
  122.                    { um die Programmgr”áe klein zu halten, }
  123.                    { wird fr ein Schlsselwort-Token der  }
  124.                    { "Text" in der Schlsselworttabelle    }
  125.                    { des Scanners nachgeschaut             }
  126.  
  127.                    for j:=1 to anz_keywords do
  128.                      if keyword_token[j]=i then
  129.                        syntaxerror(keyword[j])
  130.                 end;
  131.            end
  132.          else
  133.            token:=yylex;
  134.       end;
  135.  
  136.     procedure consume_all_until(atoken : ttoken);
  137.  
  138.       begin
  139.          while (token<>atoken) and (token<>_EOF) do
  140.            consume(token);
  141.          { this will create an error if the token is _EOF }
  142.          if token<>atoken then
  143.            consume(atoken);
  144.          { this error is fatal as we have read the whole file }
  145.          Message(scan_f_end_of_file);
  146.       end;
  147.  
  148.     procedure emptystats;
  149.  
  150.       begin
  151.          while token=SEMICOLON do
  152.            consume(SEMICOLON);
  153.       end;
  154.  
  155.     { reads a list of identifiers into a string container }
  156.     function idlist : pstringcontainer;
  157.  
  158.       var
  159.         sc : pstringcontainer;
  160.  
  161.       begin
  162.          sc:=new(pstringcontainer,init);
  163.          repeat
  164.            sc^.insert(pattern);
  165.            consume(ID);
  166.            if token=COMMA then consume(COMMA)
  167.              else break
  168.          until false;
  169.          idlist:=sc;
  170.       end;
  171.  
  172.     { inserts the symbols of sc in st with def as definition }
  173.     { sc is disposed                                         }
  174.     procedure insert_syms(st : psymtable;sc : pstringcontainer;def : pdef);
  175.  
  176.       var
  177.          s : string;
  178.  
  179.       begin
  180.          s:=sc^.get;
  181.          while s<>'' do
  182.            begin
  183.               st^.insert(new(pvarsym,init(s,def)));
  184.               { static data fields are inserted in the globalsymtable }
  185.               if (st^.symtabletype=objectsymtable) and
  186.                  ((current_object_option and sp_static)<>0) then
  187.                 begin
  188.                    s:=lowercase(st^.name^)+'_'+s;
  189.                    st^.defowner^.owner^.insert(new(pvarsym,init(s,def)));
  190.                 end;
  191.               s:=sc^.get;
  192.            end;
  193.          dispose(sc,done);
  194.       end;
  195.  
  196. end.
  197.  
  198. {
  199.   $Log: pbase.pas,v $
  200.   Revision 1.1.1.1  1998/03/25 11:18:14  root
  201.   * Restored version
  202.  
  203.   Revision 1.9  1998/03/10 01:17:23  peter
  204.     * all files have the same header
  205.     * messages are fully implemented, EXTDEBUG uses Comment()
  206.     + AG... files for the Assembler generation
  207.  
  208.   Revision 1.8  1998/03/06 00:52:40  peter
  209.     * replaced all old messages from errore.msg, only ExtDebug and some
  210.       Comment() calls are left
  211.     * fixed options.pas
  212.  
  213.   Revision 1.7  1998/03/02 01:48:59  peter
  214.     * renamed target_DOS to target_GO32V1
  215.     + new verbose system, merged old errors and verbose units into one new
  216.       verbose.pas, so errors.pas is obsolete
  217.  
  218.   Revision 1.6  1998/02/16 12:51:38  michael
  219.   + Implemented linker object
  220.  
  221.   Revision 1.5  1998/02/13 10:35:22  daniel
  222.   * Made Motorola version compilable.
  223.   * Fixed optimizer
  224.  
  225.   Revision 1.4  1998/02/12 11:50:24  daniel
  226.   Yes! Finally! After three retries, my patch!
  227.  
  228.   Changes:
  229.  
  230.   Complete rewrite of psub.pas.
  231.   Added support for DLL's.
  232.   Compiler requires less memory.
  233.   Platform units for each platform.
  234.  
  235.   Revision 1.3  1998/01/13 17:13:08  michael
  236.   * File time handling and file searching is now done in an OS-independent way,
  237.     using the new file treating functions in globals.pas.
  238.  
  239.   Revision 1.2  1998/01/09 09:09:58  michael
  240.   + Initial implementation, second try
  241.  
  242. }
  243.